COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	MAPS1 - programs for the parsing of the scene.
C00006 00003	_ external and forward procedures - LCRV
C00008 00004	_ DTRCE, LINDL, QTRCE
C00010 00005	_ MLCR, REVIVE, UPPDAL
C00012 00006	_ UNTST, BREAK
C00014 00007	_ CLUPSC
C00017 00008	_ FUSABL
C00021 00009	_ LFDIF
C00026 00010	_ MAP (VCRKEY)
C00030 00011	_ PARSE
C00033 00012	_ PARSE cont
C00035 00013	_ PARSE cont
C00038 00014	_ PARSE cont
C00040 00015	_ PARSE cont
C00042 00016	_ PARSE cont
C00045 ENDMK
C⊗;
COMMENT MAPS1 - programs for the parsing of the scene.;

ENTRY LCRV,LCRL,DTRCE,LINDL,QTRCE,MLCR,REVIVE,CLUPSC,
      UPPDAL,FUSABL,LFDIF,MAP,PARSE;

BEGIN "MAPS1"

DEFINE QC(I)="&""  I=""&CVS(I)",
	QCO(I)="&""  I=""&CVOS(I)",
	QCR(R)="&""  R=""&CVF(R)",
	NOTHING="",
	CL="'15&'12",
	QSCOR="&""   SCORE=""&CVOS(CMPL+1)&""/""&CVOS(SCO)",
	BL="'40",
	QENP="EXTERNAL PROCEDURE",
	QS="STRING",
	QESP="EXTERNAL SIMPLE STRING PROCEDURE",
	QI="INTEGER",
	QR="REAL",
	QRI="REFERENCE INTEGER",
	QRR="REFERENCE REAL",
	QEP="EXTERNAL SIMPLE PROCEDURE",
	QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
	QERP="EXTERNAL SIMPLE REAL PROCEDURE",
	QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
	QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
	QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
	_="COMMENT",
	LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
	QTRC="IF DTRACE∨MAPTRC LAND '12000 THEN QTRCE",
	DTRC="IF DTRACE∨MAPTRC LAND '10000 THEN DTRCE",
	LINSET="DISW←1; DTRC(""LINSRT:""QC(IFREEL)); LINSRT",
	BELCRE(I)="LVNEXT(I,-1)",
	SAFEX="SAFE";
INTEGER IA,DCHAN,CURMAP;
INTERNAL INTEGER PROT,PLIN,PVER,AD0,LNCS1,LNCS2,RAYS,ICH,CMPIND,
	BRCH,EOF,DTRACE,KMP,RUL,MDCTR,DISW,FLMIND,FTSW,LFDBT,BESTMP,NPRS,
	N1,N2,TC,TCS,LNCRE0;
EXTERNAL INTEGER NOEPA,NOL,MAXNOL,MAXNOV,LNCRE1,LNCRE2,
	PFTOT,MODIF,PLFTOT,MAXPLS,MAXPVS,MAPTRC,SCO,CMPL;
EXTERNAL REAL RWIC,RMAP;
SAFEX EXTERNAL INTEGER ARRAY DICH[0:1],LCREDE,LFEAT,LVERCO,LINK,
	LVERSI,PLINES,PVERTS,PPTRL,PLINE,PLINE2,PFPRO,PFEAT,
	LVER,CFEAT[1:1],PFPTR[0:1];
SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,XLCOR,YLCOR,CXL,CYL,CCL,RLEN[1:1];
SAFEX EXTERNAL STRING ARRAY PNAME[1:1];
_ external and forward procedures - LCRV;

QEP LINDEL(QI I,J);
QEIP BITS(QI I,J,K);
QEIP MAPCONV(QS CODES);
QEIP INREK(QR X,Y);
QEP UPPDAT;
QEP FTEX;
QENP XREFC(QI I);
QEP UNXREF;
QEIP LACT(QI I);
QERP ANGLIN(QI I,J);
QEIP LVOPP(QI I);
QERP SQRT(QR R);
QEIP MAX0(QI I,J);
QEIP KARN(QR X1,Y1,X2,Y2,X3,Y3,X4,Y4; QI IC);
QEP REKOP(QR X1,Y1,X2,Y2,WI; QRR RL);
QEP WEIGHV(QI I; QRR X,Y,WE);
QEIP MAPREC;
QEP PRECAL;
QEP CALC;
QEIP LVNEXT(QI I,J);
QEP REGREF(INTEGER I);
QEIP MSCVCO(QI ISV, ICV, LADD);
QEIP NEXVER;
QEIP LCRL(QI L);

_ return LCREDE entry for s.v. SV (sign and low 4 octal digits only);

INTERNAL SIMPLE INTEGER PROCEDURE LCRV(INTEGER SV);
	RETURN(LCREDE[(SV+1)%2] LAND '400000007777);

_ DTRCE, LINDL, QTRCE;

_ Produces trace output on file "PARSE.TRC" if MAPREC bit 12 is set.;

INTERNAL SIMPLE PROCEDURE DTRCE(STRING S);
	BEGIN "DTRC"
	IF DTRACE∧DCHAN=-1∨¬DTRACE∧(DTRACE←MAPTRC LAND '10000) THEN
		BEGIN
		OPEN(DCHAN←GETCHAN,"DSK",0,0,2,100,BRCH,EOF);
		ENTER(DCHAN,"PARS"&CVS(NPRS←NPRS+1)&".TRC",IA)
		END;
	IF DTRACE∧¬(DTRACE←MAPTRC LAND '10000) THEN
		 BEGIN CLOSE(DCHAN); DCHAN←-1 END;
	TC←TC+1;
	IF MAPTRC LAND '40000 THEN OUTSTR('11&CVS(TC));
	IF DTRACE THEN OUT(DCHAN,CL&CVS(TC)&'11&S);
	END "DTRC";

_ line deletion with tracing;

INTERNAL SIMPLE PROCEDURE LINDL(INTEGER L,I);
	BEGIN DISW←1; DTRC("LINDEL:"QC(L)); LINDEL(L,I) END;


_ Produces trace typeouts, and pauses if correct bit is set in MAPTRC.
  Also puts out trace on DSK-file "PARSE.TRC" if bit 12 of MAPTRC is set.;

INTERNAL SIMPLE PROCEDURE QTRCE(STRING S);
	BEGIN "QTRC"
	DTRC(S);
	IF MAPTRC LAND '2000 THEN
		BEGIN
		OUTSTR(CL&S);
		IF MAPTRC LAND '4000 THEN
			BEGIN
			WHILE (ICH←INCHRW)≠":"∧ICH≠"←" DO NOTHING;
			IF ICH="←" THEN MAPTRC←MAPCONV(INSTR(":"))
			END
		END;
	END "QTRC";
_ MLCR, REVIVE, UPPDAL;

_ Pushes LC onto the LCREDE-stack for line LN.;

INTERNAL SIMPLE PROCEDURE MLCR(INTEGER LN,LC);
	BEGIN "MLCR"
	DISW←1;
	DTRC("MLCR:  "QC(LN)QC(LC));
	IF LN THEN LCREDE[LN]←LCREDE[LN] LSH 12 LOR LC
	END "MLCR";


_ Pops LCREDE off top of stack, leaving next-to-newest value.;

INTERNAL SIMPLE PROCEDURE REVIVE(INTEGER LN);
	BEGIN "REVIVE"
	DISW←1;
	DTRC("REVIVE:  "QC(LN));
	IF LN THEN LCREDE[LN]←LCREDE[LN] LSH -12
	END "REVIVE";

_ Updates line-display, and waits for a ":" iff SW is on.;

INTERNAL SIMPLE PROCEDURE UPPDAL(INTEGER SW);
	BEGIN "UPPDAL"
	IF ¬DISW THEN RETURN ELSE DISW←0;
	IF SW>0 THEN
		BEGIN
		LNCRE1←LNCRE0;
		DICH[4]←DICH[5]←DICH[6]←1;
		UPPDAT;
		IF MAPTRC LAND '100000 THEN BEGIN PRECAL; CALC END;
		OUTSTR(" D ");
		LNCRE1←LNCS1
		END;
	IF SW THEN
		BEGIN
		WHILE (ICH←INCHRW)≠":"∧ICH≠"←" DO NOTHING;
		IF ICH="←" THEN MAPTRC←MAPCONV(INSTR(":"))
		END
	END "UPPDAL";
_ UNTST, BREAK;

_ tests cv for active and inactive lines.  Returns zero if all lines
  connected to cv are active or inactive.  If some lines of each type
  are connected, it returns the total number of lines;

SIMPLE INTEGER PROCEDURE UNTST(INTEGER CV);
	BEGIN
	INTEGER L, FL, FLG, N, RET;
	FL ← L ← LVERSI[CV];
	IF FL<0∨LVER[FL]=L THEN RETURN(0);
	FLG ← LACT((FL+1) DIV 2);
	RET ← 0;
	N ← 1;
	WHILE (L←LVER[L])≠FL DO
		BEGIN "UNA"
		IF LACT((L+1) DIV 2) XOR FLG THEN RET←-1;
		N ← N+1;
		END "UNA";
	RETURN(IF RET THEN N ELSE 0);
	END;

_ Breaks cv into two cv's, if necessary, and relinks them to seperate
  active and inactive lines.  New cv contains all inactive lines;

SIMPLE PROCEDURE BREAK(INTEGER CV);
	BEGIN
	INTEGER LN, L, NCV, I, LAD, N;
	IF ¬(N←UNTST(CV)) THEN RETURN;
	L ← LVERSI[CV];
	NCV ← 0;
	LAD ← 1;
	DO	BEGIN "BRA"
		LN ← LVER[L];
		IF ¬LACT((L+1) DIV 2) THEN
			BEGIN "BRB"
			MSCVCO(-L,CV,0);
			MSCVCO(L,-NCV,LAD);
			LAD ← LAD+1;
			IF LAD=2 THEN NCV←LVERCO[L];
			END "BRB";
		L ← LN;
		N ← N-1;
		END "BRA" UNTIL ¬N;
	END;
_ CLUPSC;
_ Cleans up the scene after the isolation of a complete or a best partial,
  i.e. removes (to LCREDE=3000+CURMAP) all unused lines coinciding with
  or contained within any line of the object. Lines of other objects
  linked to common cv's are unlinked and given new cv's;

INTERNAL PROCEDURE CLUPSC;
	BEGIN "CLUPSC" INTEGER IA,IB,IC,IV1, LV, M;
	REAL RL,X1,X2,DIFX,DIFY,Y1,Y2;
	SAFEX INTEGER ARRAY MP[1:MAXNOV];
	DEFINE BK(CV)="IF ¬MP[CV] THEN BEGIN BREAK(CV);MP[CV]←1;END",
		RESET="LNCRE1←LNCS1; LNCRE2←LNCS2";
	MP[1] ← 0;
	ARRBLT(MP[2],MP[1],MAXNOV-1);
	N1←2000+2*CURMAP;
	RWIC←2.0*RWIC;
	M ← N1-1;
	LOOP(IA,1,MAXNOL,1) IF M≤LCRL(IA)≤N1 THEN
		BEGIN "CLA"
		LNCRE1←(LNCRE2←N1)-1;
		IB←2*IA;
		X1←XVCOR[IV1←LVERCO[IB-1]];
		Y1←YVCOR[IV1];
		BK(IV1);
		X2←XVCOR[IV1←LVERCO[IB]];
		Y2←YVCOR[IV1];
		BK(IV1);
		REKOP(X1+(DIFX←RWIC*(X1-X2)/(RL←RLEN[IA])),
			Y1+(DIFY←RWIC*(Y1-Y2)/RL),
			X2-DIFX,
			Y2-DIFY,
			RWIC,
			RL);
		RESET;
		LOOP(IB,1,MAXNOL,1) IF LNCRE1≤LCREDE[IB] LAND '400000007777
			    ≤LNCRE2∧ANGLIN(IA,IB)<RMAP
			∧INREK(XVCOR[IV1←LVERCO[(IC←2*IB)-1]],YVCOR[IV1])
			∧INREK(XVCOR[IV1←LVERCO[IC]],YVCOR[IV1])
		   THEN	BEGIN "CLB"
			MLCR(IB,LNCRE1←LNCRE2←3000+CURMAP);
			BK(IV1);
			IV1←LVERCO[IC-1];
			BK(IV1);
			RESET;
			END "CLB";
	        END "CLA";
	LNCRE1←(LNCRE2←N1)-1;
	LOOP(IA,1,MAXNOV,1) IF ¬MP[IA]∧BELCRE(IA) THEN
		WEIGHV(IA,XVCOR[IA],YVCOR[IA],RL);
	RESET;
	RWIC←RWIC/2.0
	END "CLUPSC";
_ FUSABL;

_ Returns -1 (else 0) iff L2>0 and lines of s.v:s V1 and V2 are collinear.
  If L2≤0, we check whether line of s.v. L1 may be extended through V1
	(if L2=0) or V2 (if L2=-1).;

INTERNAL SIMPLE INTEGER PROCEDURE FUSABL(INTEGER L1,L2,V1,V2);
	BEGIN "FUSABL"
	INTEGER IL1;
	IL1←(L1+1)%2;
	DTRC("FUSABL:  "QC(L1)QC(L2)QC(V1)QC(V2));
	IF L2>0∧(ABS LINK[V1]=V2 ∨ ABS LINK[V2]=V1) THEN RETURN(-1);
    	IF L2≤0 THEN
	   RETURN(ABS(CXL[IL1]
			*XVCOR[N1←CASE -L2 OF(V1,V2)]
			+CYL[IL1]
			*YVCOR[N1]
			+CCL[IL1])
		   ≤RWIC
		   *SQRT((XVCOR[N1]-XLCOR[L1])↑2+(YVCOR[N1]-YLCOR[L1])↑2)
		   /RLEN[IL1]);
	RETURN(KARN(XLCOR[V1]
		   ,YLCOR[V1]
		   ,XLCOR[IL1←LVOPP(V1)]
		   ,YLCOR[IL1]
		   ,XLCOR[V2]
		   ,YLCOR[V2]
		   ,XLCOR[IL1←LVOPP(V2)]
		   ,YLCOR[IL1],-1)=1)
	END "FUSABL";
_ LFDIF;

_ Returns encoded actions to be performed at end ND2 of LF2 in order to
  make it similar to end ND1 of LF1. Other ends must agree (otherwise
  error-return = '400). The program also sets the sequential modification
  word (MODIF). MODIF contains two bits for each line-position at ND2 of
  LF2, telling what to do at that position:
  {(0 = no change)(1 = insert line here)(2 = delete line here)
	(3 unused code)}.
  MODIF←-1 if there is no unambiguous modification possible.
  MODIF has its high bit turned on iff end single before insertions.
  The program pays no attention to the outer angle at ND2 of LF2.;

INTERNAL SIMPLE INTEGER PROCEDURE LFDIF(INTEGER LF1,LF2,ND1,ND2);
	BEGIN "LFDIF"
	INTEGER C1,C2,N1,N2,NLDIF,PAR,IA,IB,DEL,CH,IRET,INS,D1,D2,IPD,
		DS1,DS2,CHAR,POS1,POS2,INSTOT,NTOT,BARAM;

_	DN is displacement for other ends. DSN originally points to
	"#lines>180", later to "#lines≤180". CN = constellation bits.
	CH=INS∨DEL all refer to first or last line respectively.;

	LABEL OU;
	DS1←31-(D1←18*ND1);
	DS2←31-(D2←18*ND2);
	MDCTR←IRET←INSTOT←NTOT←BARAM←0;
	MODIF←2;
	RAYS←BITS(LF1,DS1,DS1+3);
	IF ((LF1 LSH (-D1)) XOR (LF2 LSH (-D2))) LAND '367500 THEN
		BEGIN MODIF←-1; IRET←'400; GO OU END;

	_ The other ends are in agreement.;

	LOOP(IA,1,2,1)
		BEGIN
		C1←BITS(LF1,3+D1,4+D1);
		C2←BITS(LF2,3+D2,4+D2);
		INS←(C2=2∧(C1 LAND 1)∨C2∧¬C1);
		CH←-((DEL←C1∧¬C2∨C1=2∧(C2 LAND 1))∨INS);
		PAR←C1 LAND 1;
		IPD←INS∨PAR∧¬DEL;
		IRET←((IRET LSH 1 LOR CH) LSH 1 LOR (-DEL)) LSH 1 LOR PAR;
		NLDIF←(N1←BITS(LF1,DS1,DS1+3))-
			(N2←BITS(LF2,DS2,DS2+3))+INS-DEL;
		IRET←(   (   (   (IRET LSH 1 LOR(-(NLDIF<0)))
				  LSH 4 LOR ABS NLDIF)
			      LSH 4 LOR (POS1←IF IA=2 THEN 1 ELSE
					  IF IPD THEN 2 ELSE 1))
			  LSH 4 LOR (POS2←(IF NLDIF≥0 THEN N1 ELSE N2-INS+DEL)
					+(IA=2∧IPD)))
			  LSH 2 LOR (CHAR←IF ¬CH∧¬NLDIF THEN -(N1>0) ELSE
		  			  IF ¬NLDIF THEN 2 ELSE
					  IF ABS NLDIF=POS2-POS1+1 THEN 2 ELSE
					  	(BARAM←2)+1);
		IF CHAR<2 THEN MODIF←MODIF LSH (2*N1) ELSE
			BEGIN
			IF IA=1∧(CH∨PAR) THEN
				MODIF←MODIF LSH 2 LOR (-INS-2*DEL);
			N2←IF NLDIF<0 THEN N2+(DEL∨PAR∧¬INS) ELSE N1+IPD;
			LOOP(IB,1,N2,1)
			   MODIF←MODIF LSH 2 LOR
				(IF CHAR=3 THEN 3 ELSE
				 IF NLDIF>0 THEN 1 ELSE
				 IF ¬NLDIF THEN 0 ELSE 2);
			IF IA=2∧(CH∨PAR) THEN
				MODIF←MODIF LSH 2 LOR (-INS-2*DEL)
			END;
		D1←18-D1;
		D2←18-D2;
		DS1←DS1-5;
		DS2←DS2-5;
		INSTOT←INSTOT-INS+(0 MAX NLDIF);
		NTOT←NTOT+N1
		END;
	START_CODE LABEL L1, L2;
	SKIPG 1,MODIF;
	JRST L2;
	MOVE 2,MDCTR;
L1:	LSH 1,2;
	ADDI 2,2;
	JUMPG 1,L1;
	MOVEM 2,MDCTR;
	MOVEM 1,MODIF;
L2:	END;

	MODIF←(MODIF LAND '177777777777) LOR ((BARAM-(INSTOT=NTOT)) LSH 34);
OU:	DTRC("LFDIF:  "QCO(LF1)QCO(LF2)QC(ND1)QC(ND2)QCO(IRET)QCO(MODIF));
	RETURN(IRET)
	END "LFDIF";
_ MAP (VCRKEY);

_ Sets up the expanded parallel datastructure for prototype PROT.
  Then initializes mapping arrays according to the basic mapping
  provided by the key feature FEAT (c.f. or l.f.) from the scene
  into the prototype. Then calls MAPREC to complete the mapping,
  described in PLMAP (scene-line corresponding to prot.-line)
  and in PVMAP (scene-vertex corresponding to prot.-vertex).;

INTERNAL INTEGER PROCEDURE MAP(INTEGER LSC,LPR,DIR);
	BEGIN "MAP"
	INTEGER IA,PLNE,SHFT,IB;
	SAFE INTERNAL INTEGER ARRAY LENDV,LENDP,LLEV,LLEVO,PLMAPO[1:PLIN,0:1],
		MAPORD,PARCLA,LENCAT,INSLEV,LFTSTL[1:PLIN],VLEV[1:PVER];
	SAFE EXTERNAL INTEGER ARRAY PLMAP[1:1,0:1],FLMAPS,PVMAP[1:1],
		PARTS[0:1,1:63];

	_ Returns 1 (else 0) iff present key is unexplored (virgin).;

	SIMPLE INTEGER PROCEDURE VIRKEY;
		BEGIN "VIRKEY"
		INTEGER IA,IB;
		IB←((LSC LSH 12 LOR PROT) LSH 12 LOR LPR) LSH 1 LOR DIR;
		IF FTSW THEN LOOP(IA,1,FLMIND,1) 
			IF FLMAPS[IA]=IB THEN RETURN(0) ELSE
				ELSE FLMAPS[FLMIND←FLMIND+1]←IB;
		RETURN(1)
		END "VIRKEY";

	QTRC(CL&"PROT= "&CVS(PROT)&"  LPR= "&CVS(LPR)&"  LSC= "&CVS(LSC)&
	     "  DIR= "&CVOS(DIR)&CL);
	LFDBT←(DIR LSH -1) LAND 1 XOR (DIR←DIR LAND 1);
	IF ¬LACT(LSC)∨¬VIRKEY THEN
		BEGIN
		QTRC(CL&"Key not virgin"&CL);
		RETURN(-1)
		END;
	IF MAPTRC LAND '20000 THEN 
		BEGIN
		OUTSTR("NEW KEY - MAPTRC? ");
		IF INCHRW="←" THEN MAPTRC←MAPCONV(INSTR(":"));
		OUTSTR(CL)
		END;

	_ First set up expanded prototype datastructure,
	  and zero line-mapping arrays.;

	LOOP(IA,1,PLIN,1)
		BEGIN
		PARCLA[IA]←(PLNE←PLINE[AD0+IA]) LAND '37;
		LENCAT[IA]←PLINE2[AD0+IA] LSH -9 LAND 1;
		LOOP(IB,0,1,1)
			BEGIN
			PLMAP[IA,IB]←LLEV[IA,IB]←0;
			LENDV[IA,IB]←BITS(PLNE,30-(SHFT←6*IB),35-SHFT);
			LENDP[IA,IB]←BITS(PLNE,18-SHFT,23-SHFT)
		        END
		END;
	LOOP(IA,1,PVER,1) PVMAP[IA]←VLEV[IA]←0;

	_ Initialize the mapping (1 line) and call on MAPREC to do the job.;

	MAPORD[1]←LPR;
	MLCR(LSC,1001);
	PLMAP[LPR,1-LFDBT]←2*LSC-(DIR XOR LFDBT);
	LLEV[LPR,1-LFDBT]←1;
	PARTS[CMPIND,0]←PROT; KMP←1;
	RETURN(MAPREC)
	END "MAP";
_ PARSE;


_ Will attempt to find a satisfactory parsing of the scene. Note that the
  PARTS-storage implementation limits the number of lines to 511.;

INTERNAL PROCEDURE PARSE;
	BEGIN "PARSE"
	LABEL ITER,REP,REV,ISO,BA1;
	SAFE INTERNAL INTEGER ARRAY PLMAP[1:MAXPLS,0:1],PVMAP[1:MAXPVS],
		PARTS[1:63,0:1+MAXPLS%3],FLMAPS[1:MAXNOV];
	INTEGER MAXCOM,IA,IB,KADR,PFP,CFP,PRP,SCL1,SCL2,PRL1,PRL2,
		LB,UB,FTI,UBI,DIR,IBB,ICC,
		ORD,SUCC,IC,ID,MXMXCM,I1,I2,I3,REVER,PARTSI;


	_ Returns s.v.-entry in PARTS, corresponding
	  to prototype line L of mapping M.;

	INTERNAL SIMPLE INTEGER PROCEDURE LPARTS(INTEGER M,L);
		RETURN(BITS(PARTS[M,IBB←(L+2)%3],ICC←12*(3*IBB-L),ICC+11));

	_ Returns line indicated in LPARTS(M,L), 0 iff no line specified.;

	INTERNAL SIMPLE INTEGER PROCEDURE LPARTL(INTEGER M,L);
		RETURN(((IF (IBB←LPARTS(M,L) LAND '1777)≠'1777 THEN IBB
			ELSE 0)+1)%2);

	LNCRE0←LNCS1←LNCRE1;
	LNCS2←LNCRE2;
	IF MAPTRC=-1 THEN
		BEGIN
		MAPTRC←0;
		LOOP(IA,1,MAXNOL,1)
			BEGIN
			WHILE (IB←LCRL(IA))>2000 DO REVIVE(IA);
			IF IB=1001 THEN REVIVE(IA) ELSE
			    IF IB≥1002∧IB≤1005 THEN LINDL(IA,0)
			END;
		UNXREF;
		UPPDAL(0);
		RETURN
		END;
	DTRACE←MAPTRC LAND '10000;
	DCHAN←NPRS←-1;
	QTRC(CL&"PARSER RESULTS:"&CL);
_ PARSE cont;

	_ Initialize PFPTR.;

	TC←TCS←CURMAP←0;
	PARTSI←1+MAXPLS%3;
REP:	LB←PLFTOT+1;
	UB←PFTOT;
	UBI←1;
	FTSW←FLMIND←0;
	QTRC("CF-keys"&CL);
    	XREFC(0);
	FTEX;

	_ Display scene?;

     	IF MAPTRC LAND '1000000 THEN
		BEGIN
		OUTSTR(CL&"SCENE");
		UPPDAL(MAPTRC LAND '2000000)
	        END;
	LOOP(IA,1,PFTOT,1) PFPTR[IA]←PFPTR[IA] LAND '377777777777;

	_ Find un-exhausted key of maximum complexity.;

	MXMXCM←BESTMP←0;
	CMPIND←(CURMAP←CURMAP+1)+1;
	PARTS[CMPIND,0]←1;
	LOOP(IA,1,MAXNOV,1) FLMAPS[IA]←0;
ITER:	MAXCOM←KMP←SUCC←0;
	LOOP(IA,UB,LB,-1) IF MAXCOM<PFPTR[IA] THEN
		IF(MAXCOM←PFPTR[KADR←IA])=MXMXCM THEN DONE;
	IF ¬MAXCOM THEN GO ISO;
	MXMXCM←MAXCOM;
_ PARSE cont;

	_ Now exhaust the mappings where this feature serves as the key.;

	CFP←BITS(IC←PFPTR[KADR],12,23);
	ORD←IC LAND '4000000000;
	DTRC(" "QC(KADR)QC(CFP)QC(ORD));
	LOOP(FTI,1,UBI,1) IF ¬FTSW∨LNCRE1≤LCREDE[FTI] LAND '400000007777
		≤LNCRE2∧((IB←LFEAT[FTI])<0∧
	   FTSW=2∨IB>0∧FTSW=1)∧KADR=IB LAND '7777 THEN
	   WHILE (CFP←CFP+FTSW) DO
		BEGIN "CFPL"
		SCL1←IF FTSW THEN FTI ELSE BITS(IC←CFEAT[CFP],24,34);
		IF ¬FTSW THEN SCL2←BITS(IC,12,22);
		PRP←PFPTR[KADR] LAND '7777;
		WHILE PRP DO
			BEGIN "PRPL"
			PROT←BITS(PFPRO[PRP],24,35);
			AD0←PPTRL[PROT]-1;
			PLIN←PLINES[PROT];
			PVER←PVERTS[PROT];
			PFP←BITS(PFPRO[PRP],12,23)+1;
			WHILE PFP>1 DO
				BEGIN "PFPL"
				PRL2←PRL1←BITS(IB←PFEAT[PFP],24,33);
				IF ¬FTSW THEN PRL2←BITS(IB,12,21);
				QTRC(CL&"FEAT: "&CVS(KADR)&"  SC-LNS: "&
					CVS(SCL1)&BL&CVS(SCL2)&
					"  PROT: "&CVS(PROT)&"  PR-LNS: "&
					CVS(PRL1)&BL&CVS(PRL2)&CL);
				DIR←IF FTSW THEN
				   LFEAT[FTI] LSH -33 ELSE
				   BITS(IB,34,34) XOR (ID←BITS(IC,35,35));
				SUCC←MAP(SCL1,PRL1,DIR);
				REVER←0;
BA1:				IF SUCC≥0∧MAPTRC LAND '100 THEN
					BEGIN
					OUTSTR(CL&"BEST(MAP) - PROT: "&
						PNAME[PROT]QSCOR&CL);
					LNCRE0←LNCRE2←1006;
					LOOP(I1,1,PLIN,1)
						MLCR(LPARTL(CMPIND,I1),1006);
					UPPDAL(MAPTRC LAND '200);
					LNCRE0←LNCS1;
					LNCRE2←LNCS2;
					LOOP(I1,1,PLIN,1)
						REVIVE(LPARTL(CMPIND,I1))
					END;
				CASE SUCC+1 OF BEGIN GO REV; ; GO ISO; ; END;
_ PARSE cont;
_				 We have here a maximal partial mapping for
				this key.  See if it is a maximal partial
				for this iteration of PARSE. If it is,
				then save inserted lines at LCREDE=1005.;

		 		I3←¬BESTMP
				    ∨SUCC=2
				    ∨PARTS[CMPIND,0] LAND '777777777
					> PARTS[BESTMP,0] LAND '777777777;
				IF I3 THEN
					BEGIN
					BESTMP←CMPIND;
					QTRC(CL&"New best partial"&CL)
				        END;
				LOOP(IA,1,MAXNOL,1)
					IF (I2←LCRL(IA))=1005
					    ∧I3
					    ∨I2=1004
					    ∧¬I3
						THEN LINDL(IA,0) ELSE
					IF I3∧I2=1004 THEN
						LCREDE[IA]←LCREDE[IA]+1;
				IF SUCC=2 THEN GO ISO;
				IF (CMPIND←CMPIND+1)>63 THEN
					BEGIN
					QTRC(CL&"Mappings in excess of 63."&
						"Isolate best."&CL);
					GO ISO
					END;
REV:				IF ¬REVER∧ORD THEN
					BEGIN
					SUCC←MAP(SCL1,PRL2,IF FTSW THEN 1-DIR
						ELSE BITS(IB,22,22) XOR ID);
					REVER←1;
					GO BA1
				        END;

_				Display scene?;

				IF SUCC+1∧KMP∧MAPTRC LAND '200000 THEN
					BEGIN
					OUTSTR(CL&"SCENE");
					UPPDAL(MAPTRC LAND '400000)	
				        END;	
_ PARSE cont;
_				Parsing process continues normally with next
				key ( = scene-line(s) & prototype &
				prototype-line(s) combination).;

				PFP←PFEAT[PFP] LAND '7777
			        END "PFPL";
			PRP←PFPRO[PRP] LAND '7777
			END "PRPL";
		CFP←IF FTSW THEN -FTSW ELSE CFEAT[CFP] LAND '7777;
                END "CFPL";

_	Iterate at this point, starting by finding the best
	unused key-feature at this stage.;

	PFPTR[KADR]←PFPTR[KADR] LOR '400000000000;
	GO ITER;

_	Use l.f. keys as well, before deciding on mapping.;

ISO:	IF SUCC<1∧FTSW<2 THEN
		BEGIN
		FTSW←FTSW+1;
		LB←1;
		UB←PLFTOT;
		UBI←MAXNOL;
		SCL2←PRL2←MXMXCM←0;
		IF FTSW=2 THEN LOOP(IA,1,PLFTOT,1) PFPTR[IA]←
			PFPTR[IA] LAND '377777777777;
		QTRC((CASE FTSW OF("L","L","P"))&"F-keys"&CL);
		GO ITER
                END;

_	Isolation of partial (or complete) object.;
_	First check if the parsing process is at an end.;

	IF ¬BESTMP∧¬SUCC THEN
		BEGIN
		QTRC(CL&"SCENE EXHAUST ED  -  END OF PARSE"&CL);
		DTRACE←MAPTRC←0;
		IF DTRACE THEN BEGIN CLOSE(DCHAN); DCHAN←-1;END;
		RETURN
 	        END;

_	There is a partial or complete. Save mapping.;

	I2← IF SUCC=1 THEN CMPIND ELSE BESTMP;
	LOOP(I1,0,PARTSI,1) PARTS[CURMAP,I1]←PARTS[I2,I1];
_ PARSE cont;

_	Now truck object off to LCREDE=2000+2*CURMAP.;

	CMPIND←2000+2*CURMAP;
	I2←PLINES[N1←PARTS[CURMAP,0] LSH -30];
	LOOP(I1,1,I2,1) MLCR(I3←LPARTL(CURMAP,I1),CMPIND+(LCRL(I3)≠1004));
	IF MAPTRC LAND '400 THEN
		BEGIN
		OUTSTR(CL&"BEST(PARSE) - PROT: "&PNAME[N1]QSCOR&CL);
		LNCRE0←LNCRE2←1006;
		LOOP(I1,1,I2,1) MLCR(LPARTL(CURMAP,I1),1006);
		UPPDAL(MAPTRC LAND '1000);
		LNCRE0←LNCS1;
		LNCRE2←LNCS2;
		LOOP(I1,1,I2,1) REVIVE(LPARTL(CURMAP,I1))
		END;

_	 Finally clean up the scene, shipping all replaced lines
	(partial lines belonging to the object but superceded as members
	of the mapping) into oblivion at LCREDE=3000+CURMAP;

	CLUPSC;
	IF MAPTRC LAND '4000000 THEN
		BEGIN
		LNCRE1←1;
		LNCRE2←4000;
		REGREF(11);
		LNCRE1←LNCS1;
		LNCRE2←LNCS2;
		END;

_	Now the scene may have changed in some relevant way, so before
	  going through a renewed cross-reference investigation and
	  feature-extraction, and continuing the parse, we perform an
	  UNXREF to detach topologically all removed or transferred lines.;

	UNXREF;
	GO REP
	END "PARSE";
END "MAPS1";